home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / internet / source / srobj.rpg < prev    next >
Encoding:
Text File  |  1995-12-11  |  7.4 KB  |  164 lines
  1.       *----------------------------------------------------------------
  2.       * SAVFRPG - COPIES DATA TO AND FROM A SAVEFILE
  3.       *----------------------------------------------------------------
  4.       * ARGUMENTS:
  5.       *   SFNAME - SAVEFILE NAME
  6.       *   SFLIB  - SAVEFILE LIBRARY
  7.       *   DFNAME - DATA FILE NAME
  8.       *   DFLIB  - DATA FILE LIBRARY
  9.       *   DIRECT - COPY DIRECTION. 'FROMSAVF' OR 'TOSAVF'
  10.       *----------------------------------------------------------------
  11.       * COPY DATA FROM SAVEFILE TO DATA FILE
  12.      FSAVFF   IF  F     528            DISK                           UC
  13.      FTOFILEF O   F     528            DISK                           UC
  14.       *----------------------------------------------------------------
  15.       * COPY DATA FROM DATA FILE TO SAVE FILE
  16.      FFRFILET IF  F     528            DISK                           UC
  17.      FSAVFT   O   F     528            DISK                           UC
  18.       *----------------------------------------------------------------
  19.      ISAVFF   AA  01
  20.      I                                        1 528 DATAF
  21.       *----------------------------------------------------------------
  22.      IFRFILET AA  01
  23.      I                                        1 528 DATAT
  24.       *----------------------------------------------------------------
  25.       * CONSTANTS USED FOR UPPERCASE CONVERSION
  26.      I            DS
  27.      I              'ABCDEFGHIJKLMNOPQRST-C         UP
  28.      I              'UVWXYZ'
  29.      I              'abcdefghijklmnopqrst-C         LO
  30.      I              'uvwxyz'
  31.       *----------------------------------------------------------------
  32.      C           *ENTRY    PLIST                           PARAMETERS
  33.      C                     PARM           SFNAME 10        SAVF NAME
  34.      C                     PARM           SFLIB  10        SAVF LIB
  35.      C                     PARM           DFNAME 10        DATA FILE
  36.      C                     PARM           DFLIB  10        DATA LIB
  37.      C                     PARM           DIRECT  8        DIRECTION
  38.       *----------------------------------------------------------------
  39.       * UPPER CASE PARAMETERS
  40.      C           LO:UP     XLATESFNAME    SFNAME
  41.      C           LO:UP     XLATESFLIB     SFLIB
  42.      C           LO:UP     XLATEDFNAME    DFNAME
  43.      C           LO:UP     XLATEDFLIB     DFLIB
  44.      C           LO:UP     XLATEDIRECT    DIRECT
  45.       *----------------------------------------------------------------
  46.       * CHECK DIRECTION PARAMETER
  47.      C                     SELEC
  48.      C           DIRECT    WHEQ 'FROMSAVF'
  49.      C           DIRECT    WHEQ 'TOSAVF  '
  50.      C                     OTHER                           INVALID DATA
  51.      C                     GOTO EXIT
  52.      C                     ENDSL
  53.       *----------------------------------------------------------------
  54.       * MAINLINE
  55.       *
  56.       * OVERRIDE FILES
  57.      C                     EXSR DOOVR
  58.       * OPEN FILES
  59.      C                     EXSR OPENFI
  60.       * PROCESS FILES
  61.      C                     EXSR PROCES
  62.       * CLOSE FILES
  63.      C                     EXSR CLOSEF
  64.       *----------------------------------------------------------------
  65.       * EXIT APPLICATION
  66.      C           EXIT      TAG
  67.      C                     MOVE *ON       *INLR
  68.       *----------------------------------------------------------------
  69.      C           PROCES    BEGSR
  70.      C           DIRECT    IFEQ 'FROMSAVF'
  71.       * COPY DATA FROM SAVEFILE TO DATA FILE
  72.      C                     READ SAVFF                    40
  73.      C           *IN40     DOWEQ*OFF
  74.      C                     EXCPTFSAVF
  75.      C                     READ SAVFF                    40
  76.      C                     ENDDO
  77.      C                     ELSE
  78.       * COPY DATA FROM DATA FILE TO SAVEFILE
  79.      C                     READ FRFILET                  40
  80.      C           *IN40     DOWEQ*OFF
  81.      C                     EXCPTTSAVF
  82.      C                     READ FRFILET                  40
  83.      C                     ENDDO
  84.      C                     ENDIF
  85.      C                     ENDSR
  86.       *----------------------------------------------------------------
  87.      C           OPENFI    BEGSR
  88.       * OPEN FILES
  89.      C           DIRECT    IFEQ 'FROMSAVF'
  90.      C                     OPEN SAVFF
  91.      C                     OPEN TOFILEF
  92.      C                     ELSE
  93.      C                     OPEN SAVFT
  94.      C                     OPEN FRFILET
  95.      C                     ENDIF
  96.      C                     ENDSR
  97.       *----------------------------------------------------------------
  98.      C           CLOSEF    BEGSR
  99.       * CLOSE FILES
  100.      C           DIRECT    IFEQ 'FROMSAVF'
  101.      C                     CLOSESAVFF
  102.      C                     CLOSETOFILEF
  103.      C                     ELSE
  104.      C                     CLOSESAVFT
  105.      C                     CLOSEFRFILET
  106.      C                     ENDIF
  107.      C                     ENDSR
  108.       *----------------------------------------------------------------
  109.      C           DOOVR     BEGSR
  110.       * OVERRIDE FILES
  111.      C           DIRECT    IFEQ 'FROMSAVF'
  112.      C                     MOVEL'SAVFF   'ONE    10
  113.      C                     ELSE
  114.      C                     MOVEL'SAVFT   'ONE    10
  115.      C                     ENDIF
  116.      C                     MOVELSFNAME    THREE  10
  117.      C                     MOVELSFLIB     TWO    10
  118.      C                     EXSR OVRDBF
  119.      C           DIRECT    IFEQ 'FROMSAVF'
  120.      C                     MOVEL'TOFILEF 'ONE
  121.      C                     ELSE
  122.      C                     MOVEL'FRFILET 'ONE
  123.      C                     ENDIF
  124.      C                     MOVELDFNAME    THREE
  125.      C                     MOVELDFLIB     TWO
  126.      C                     EXSR OVRDBF
  127.      C                     ENDSR
  128.       *----------------------------------------------------------------
  129.      C           OVRDBF    BEGSR
  130.       * CREATES - OVRDBF(ONE) TOFILE(TWO/THREE)
  131.       *   EXPECTS ONE, TWO & THREE
  132.      C                     MOVE *BLANKS   WORK   80
  133.      C                     MOVEL'OVRDBF'  WORK
  134.      C                     MOVE 'FILE(   'STRING  8
  135.      C           WORK      CAT  STRING:1  WORK
  136.      C           WORK      CAT  ONE:0     WORK
  137.      C                     MOVE ') TOFILE'STRING  8
  138.      C           WORK      CAT  STRING:0  WORK
  139.      C                     MOVE '(       'STRING  8
  140.      C           WORK      CAT  STRING:0  WORK
  141.      C           WORK      CAT  TWO:0     WORK
  142.      C                     MOVE '/       'STRING  8
  143.      C           WORK      CAT  STRING:0  WORK
  144.      C           WORK      CAT  THREE:0   WORK
  145.      C                     MOVE ')       'STRING  8
  146.      C           WORK      CAT  STRING:0  WORK
  147.      C                     EXSR QEXC
  148.      C                     ENDSR
  149.       *----------------------------------------------------------------
  150.      C           QEXC      BEGSR
  151.       * PROCESS OVERRIDES
  152.      C                     CALL 'QCMDEXC'
  153.      C                     PARM           WORK
  154.      C                     PARM 80        QCMDLN 155
  155.      C                     ENDSR
  156.       *----------------------------------------------------------------
  157.       * OUTPUT TO SAVEFILE
  158.      OTOFILEF E                FSAVF
  159.      O                         DATAF    528
  160.       * OUTPUT TO DATA FILE
  161.      OSAVFT   E                TSAVF
  162.      O                         DATAT    528
  163.       *----------------------------------------------------------------
  164.